perm filename WINTER.SAI[VIS,HPM]2 blob sn#110599 filedate 1974-07-04 generic text, type C, neo UTF8
COMMENT ⊗   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	BEGIN "WINTER"
C00006 ENDMK
C⊗;
BEGIN "WINTER"
REQUIRE "WINNIC.SAI[VIS,HPM]" SOURCE_FILE;

INTEGER ARRAY CHAN[0:5]; INTEGER WINDOW,I,J,MAC;
REAL SUM,TX,TY,T0; STRING FILN;

CHAN[0]←'32; CHAN[1]←'37; CHAN[2]←'33; CHAN[3]←'34; CHAN[4]←'35; CHAN[5]←'36;
DDINIT; SCREEN(-.2,1.2,1.2,-.2); DRKEN; RECTAN(-2,-2,2,2);
DO OUTSTR("FILENAME:") UNTIL
	PIXDIM((FILN←INCHWL)&(IF FILN[∞ TO ∞]="]" THEN "" ELSE "[DAT,BGB]"));
OUTSTR("WINDOW SIZE:"); WINDOW←CVD(INCHWL); INIWIN(WINDOW);

OUTSTR("PICSIZ "&CVS(PICSIZ)&
 "  WIDTH "&CVS(PICWID)&"  HEIGHT "&CVS(PICHIG)&"  WINDOW "&CVS(WINDOW)&
 "  VERWIN "&CVS(VERWIN)&"  HORWIN "&CVS(HORWIN)&'15&'12);

 BEGIN INTEGER I,J; REAL X,Y;
 INTEGER ARRAY PIC[1:PICSIZ],WINS[-1:VERWIN,1:HORWIN];
 TX←WINDOW/PICWID;
 TY←WINDOW/PICHIG;
 GETPIX(PIC[1]);
 OUTSTR("DISPLAY?"); IF INCHWL="Y" THEN
  BEGIN
  FOR I←1 STEP 1 UNTIL 5 DO DPYUP('36);
  LITEN; TXTPOS(0,1.2,.04,-.08); TEXT(FILN); DRKEN;
  FOR I←4 STEP -1 UNTIL (5-PICBIT) MAX 0 DO
   BEGIN
   RECTAN(0,0,1,1);
   VIDEO(0,0,1,1,PIC[1],2↑(PICBIT+I-5));
   FOR J←1 STEP 1 UNTIL 5 DO DPYUP(CHAN[I]);
   END;
  END;

 RECTAN(-2,-2,2,2); LITEN;
 FOR J←0 STEP 1 UNTIL HORWIN DO
  BEGIN
  X←J*TX;
  LINE(X,0,X,-.02); LINE(X,1,X,1.02);
  END;
 FOR I←0 STEP 1 UNTIL VERWIN DO
  BEGIN
  Y←I*TY;
  LINE(0,Y,-.02,Y); LINE(1,Y,1.02,Y);
  END;

 DPYUP(CHAN[5]);
 SETFORMAT(0,2);
 T0←CALL(0,"RUNTIM"); SUM←DOWIN(PIC[1],WINS[1,1]); 
 OUTSTR("TIME "&CVF((CALL(0,"RUNTIM")-T0)/1000)&'15&'12);
 FOR I←1 STEP 1 UNTIL VERWIN DO
 FOR J←1 STEP 1 UNTIL HORWIN DO
  BEGIN  INTEGER II,JJ,WMAX;
  X←(J-1)*TX;
  Y←(I-1)*TY;
  
  IF (WINS[I,J] LAND 1)=0 ∧ WINS[I,J]>SUM THEN
   BEGIN
   LINE(X,Y,X+TX,Y);
   LINE(X+TX,Y,X+TX,Y+TY);
   LINE(X+TX,Y+TY,X,Y+TY);
   LINE(X,Y+TY,X,Y);
   END;

 END;
FOR I←1 STEP 1 UNTIL 5 DO DPYUP(CHAN[5]);

MAKPIX(VERWIN,HORWIN,6);
 BEGIN
 INTEGER ARRAY POUT[1:PICSIZ];
 FOR I←1 STEP 1 UNTIL VERWIN DO FOR J←1 STEP 1 UNTIL HORWIN
			DO PUTEL(POUT[1],I,J,63*SQRT(WINS[I,J]/MAC));
 PUTPIX(POUT[1],"TMP.TMP");
 END;
END;

END;